/* $Id: module.c 1119 2010-12-12 21:29:18Z phrakt $
/*
 * Copyright (c) 2004 Jean-Francois Brousseau <jfb@fugusec.net>
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 *
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. The name of the author may not be used to endorse or promote products
 *    derived from this software without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
 * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
 * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
 * THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
 * EXEMPLARY, OR CONSEQUENTIAL  DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */



#include <sys/types.h>

#include <ctype.h>
#include <errno.h>
#include <string.h>
#include <unistd.h>
#include <stdlib.h>

#include <EXTERN.h>
#include <perl.h>

#include <canopy/sys.h>
#include <canopy/queue.h>

#include "module.h"
#include "mod_perl.h"



static void   perlmod_free    (void *);
static char** perlmod_initenv (void);


static char  perl_modbase[CANOPY_PATH_MAX] = "/home/jfb/nemo/lib/nemod/perl";

static TAILQ_HEAD(, perl_mod) perl_modules;


/* mod_perl-specific environment variables */
static const struct mp_env {
	const char vname[32];
	const char vval[32];
} mod_perl_env[] = {
	{ "MOD_PERL", "1" },
};

#define MOD_PERL_NBENV   (sizeof(mod_perl_env)/sizeof(mod_perl_env[0]))



/*
* mod_perl_modinit()
*
* Initialize support for Perl modules.
*/

int
mod_perl_modinit(void)
{
	TAILQ_INIT(&perl_modules);

	return (0);
}


/*
* perlmod_find()
*
* Find a module in the list of currently loaded modules.
* Returns a pointer to the module structure on success, or NULL on failure.
*/

const struct perl_mod*
perlmod_find(const char *modname)
{
	struct perl_mod *pmp;

	TAILQ_FOREACH(pmp, &perl_modules, mod_link) {
		if (strcmp(pmp->mod_name, modname) == 0) {
			return (pmp);
		}
	}

	return (NULL);
}


/*
* perlmod_load()
*
* Load the Perl module found in the file <modpath> and parse the code
* contained in it.
* Returns a pointer to the newly loaded module, or NULL on error.
*/

struct perl_mod*
perlmod_load(const char *modpath)
{
	char *cp;
	struct perl_mod *pmod;

	pmod = (struct perl_mod *)malloc(sizeof(*pmod));
	if (pmod == NULL) {
		return (NULL);
	}
	memset(pmod, 0, sizeof(pmod));

	pmod->interp = perl_alloc();
	perl_construct(pmod->interp);

	snprintf(pmod->mod_path, sizeof(pmod->mod_path),
	    "%s/%s", perl_modbase, modpath);

	strlcpy(pmod->mod_name, modpath, sizeof(pmod->mod_name));

	TAILQ_INSERT_TAIL(&perl_modules, pmod, mod_link);

	return (pmod);
}


/*
* perlmod_unload()
*
* Unload a Perl module previously loaded.  Before unloading, the cleanup
* routine is called if cleanup hasn't already occured.  The module structure
* itself and all associated data is freed.  Any subsequent operations on
* the module pointer <pmod> will give undefined results.
*
* Returns 0 on success, or -1 on failure.
*/

int
perlmod_unload(struct perl_mod *pmod)
{
	int ret;

	if (!(pmod->mod_flags & PERLMOD_INITDONE)) {
		/* no cleanup if no init */
		return (0);
	}

	if (!(pmod->mod_flags & PERLMOD_CLEANUPDONE)) {
		ret = perlmod_cleanup(pmod);
	}

	/* now get it out of the list */
#if 0
	if (nemolist_plop(perl_modules, pmod) < 0) {
	}
#endif

	perlmod_free(pmod);

	return (0);
}


/*
* perlmod_parse()
*
* Parse the file corresponding to the module <pmod> with the Perl interpreter.
* If the file was already parsed, a check is first made to see if the
* file's checksum still matches.  If it doesn't, the module is reparsed and
* the checksum is updated.
* Returns 0 on success, or -1 on failure.
*/

int
perlmod_parse(struct perl_mod *pmod)
{
	int parseret;
	char *argv[] = { MOD_PERL_IDENT, pmod->mod_path, NULL };
	char cksum_buf[64], **envp;

	envp = perlmod_initenv();
	if (envp == NULL) {
		return (-1);
	}

	PERL_SET_CONTEXT(pmod->interp);

	parseret = perl_parse(pmod->interp, mod_perl_xsinit, 2, argv, envp);
	if (parseret != 0) {
		return (-1);
	}

	mod_perl_require(pmod, mod_perl_startup_path);

	pmod->mod_flags |= PERLMOD_PARSED;

	return (0);
}


/*
* perlmod_init()
*
* Initialize the module passed as argument.
* Returns 0 on success, or -1 on failure.
*/

int
perlmod_init(struct perl_mod *pmod)
{
	I32 ret, flags;
	dSP;

	if (pmod->mod_flags & PERLMOD_INITDONE) {
		return (0);
	}

	if (!(pmod->mod_flags & PERLMOD_PARSED)) {
		if (perlmod_parse(pmod) < 0) {
			return (-1);
		}
	}

	flags = G_NOARGS | G_SCALAR | G_EVAL;

	ENTER;
	SAVETMPS;
	PUSHMARK(SP);

	printf("calling init\n");
	ret = call_pv(PERL_MOD_INITSUB, flags);
	if (ret != 1) {
		return (-1);
	}

	SPAGAIN;

	/* now check the real return value of the init call */
	ret = POPi;
	if (ret == -1) {
		return (-1);
	}

	pmod->mod_flags |= PERLMOD_INITDONE;

	return (0);
}


/*
* perlmod_cleanup()
*
* Call the Perl module <pmod>'s cleanup routine if there is one.
* Returns 0 on success, or -1 on failure.
*/

int
perlmod_cleanup(struct perl_mod *pmod)
{
	I32 flags, ret;

	flags = G_NOARGS | G_VOID | G_EVAL;

	if (pmod->mod_flags & PERLMOD_CLEANUPDONE) {
		return (0);
	}

	printf("cleanup is being called\n");
	ret = call_pv(PERL_MOD_CLEANUPSUB, flags);
	if (ret != 1) {
		return (-1);
	}

	pmod->mod_flags |= PERLMOD_CLEANUPDONE;

	return (0);
}


/*
* mod_perl_loadall()
*
* Quick hack!
*/

void
perlmod_loadall(void)
{
	struct perl_mod *pmod;

	TAILQ_FOREACH(pmod, &perl_modules, mod_link) {
		if (perlmod_init(pmod) < 0) {
			return;
		}
	}
}


void
perlmod_unloadall(void)
{
	struct perl_mod *pmod;

}


/*
* perlmod_free()
*
*/

static void
perlmod_free(void *vp)
{
	struct perl_mod *pmod;

	if (vp != NULL) {
		pmod = (struct perl_mod *)vp;

		free(pmod);
	}
}


/*
* perlmod_initenv()
*
* Create a copy of the environment of the process in which we're executing
* and add mod_perl-specific variables.
* Returns a pointer to the newly allocated environment array, or NULL on
* failure.
*/

char**
perlmod_initenv(void)
{
	u_int i, envc;
	char **env_copy, *envp, tmp[128];

	/* first, figure out how large the original env is */
	for (envc = 0;; envc++) {
	}

	env_copy = (char **)calloc(envc + MOD_PERL_NBENV + 1, sizeof(char *));
	if (env_copy == NULL) {
		return (NULL);
	}

	for (i = 0; i < envc; i++) {
	}

	for (i = 0; i < MOD_PERL_NBENV; i++) {
		snprintf(tmp, sizeof(tmp), "%s=%s", mod_perl_env[i].vname,
		    mod_perl_env[i].vval);
		env_copy[envc + i] = strdup(tmp);
		if (env_copy[envc + i] == NULL) {
			return (NULL);
		}
	}

	env_copy[envc + MOD_PERL_NBENV] = NULL;

	return (env_copy);
}
